home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / compiler / misc.ml < prev    next >
Encoding:
Text File  |  1993-09-24  |  1.5 KB  |  82 lines  |  [TEXT/MPS ]
  1. (* Various useful stuff *)
  2.  
  3. #open "config";;
  4.  
  5. exception Zinc of string;;
  6.  
  7. let fatal_error s = raise (Zinc s);;
  8.  
  9. exception Toplevel;;
  10.  
  11. let toplevel = ref false;;
  12.  
  13. let print_begline s =
  14.   (if !toplevel then print_string toplevel_output_prompt
  15.                 else print_string batch_output_prompt);
  16.   print_string s
  17. ;;
  18.  
  19. let prerr_begline s =
  20.   (if !toplevel then prerr_string toplevel_error_prompt
  21.                 else prerr_string batch_error_prompt);
  22.   prerr_string s
  23. ;;
  24.  
  25. let prerr_endline2 s =
  26.   prerr_endline s; prerr_endline ""
  27. ;;
  28.  
  29. let load_path = ref ([] : string list)
  30. ;;
  31.  
  32. let file_exists filename =
  33.   try
  34.     sys__close(sys__open filename [sys__O_RDONLY] 0); true
  35.   with sys__Sys_error _ ->
  36.     false
  37. ;;
  38.  
  39. let cannot_find filename =
  40.   prerr_begline " Cannot find file ";
  41.   prerr_endline filename;
  42.   raise Toplevel
  43. ;;
  44.  
  45. let find_in_path filename =
  46.   if file_exists filename then
  47.     filename
  48.   else if filename__is_absolute filename then
  49.     cannot_find filename
  50.   else
  51.     let rec find = function
  52.       [] ->
  53.         cannot_find filename
  54.     | a::rest ->
  55.         let b = filename__concat a filename in
  56.           if file_exists b then b else find rest
  57.     in find !load_path
  58. ;;
  59.  
  60. let rollback_buffer = ref ([] : (unit -> unit) list)
  61. ;;
  62. let reset_rollback () =
  63.   rollback_buffer := []
  64. ;;
  65.  
  66. let add_rollback f =
  67.   rollback_buffer := f :: !rollback_buffer
  68. ;;
  69.  
  70. let rec rollback () =
  71.   match !rollback_buffer with
  72.     [] -> ()
  73.   | f::rest -> f (); rollback_buffer := rest; rollback()
  74. ;;
  75.  
  76. let remove_file f =
  77.   try
  78.     sys__remove f
  79.   with sys__Sys_error _ ->
  80.     ()
  81. ;;
  82.